home *** CD-ROM | disk | FTP | other *** search
Wrap
' TGLayout.Bas - Routines used with True Grid ' 94/05/06 Copyright 1994, Larry Rebich, The Bridge, Inc. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Option Explicit DefInt A-Z ' GetTempFileName Declare Function GetTempFileName Lib "Kernel" (ByVal cDriveLetter As Integer, ByVal lpPrefixString As String, ByVal wUnique As Integer, ByVal lpTempFileName As String) As Integer ' Grid Layout Type Type TrueGridLayout WhichLen As Integer 'length of which Which As String 'which grid, TablePeople, etc. TypeLen As Integer 'length of type Type As String 'Factory or Current, could be anything LastUpdatedLen As Integer 'length of date and time LastUpdated As String 'last updated, date and time ValueLen As Integer 'length of the layout Value As Variant 'the layout, 2000 or more characters End Type Function GridGetLayout (TheFile As String, Which As String, What As String, TheGrid As Control) As Integer ' Logic: Read the file sequentially looking for the required saved layout. ' If found then set the grid with the stored layout information. ' If not found then exit without setting the grid. Dim ALayout As TrueGridLayout Dim fi As Integer 'input file Dim bi As Integer 'which byte in input file bi = 1 'first byte fi = FreeFile 'a file handle GridGetLayout = False 'not changed Open TheFile For Binary As #fi Do Until bi > LOF(fi) Get #fi, bi, ALayout.WhichLen ALayout.Which = String$(ALayout.WhichLen, Chr$(0)) Get #fi, , ALayout.Which Get #fi, , ALayout.TypeLen ALayout.Type = String$(ALayout.TypeLen, Chr$(0)) Get #fi, , ALayout.Type Get #fi, , ALayout.LastUpdatedLen ALayout.LastUpdated = String$(ALayout.LastUpdatedLen, Chr$(0)) Get #fi, , ALayout.LastUpdated Get #fi, , ALayout.ValueLen ALayout.Value = String$(ALayout.ValueLen, Chr$(0)) Get #fi, , ALayout.Value If ALayout.Which = Which And ALayout.Type = What Then 'match If TheGrid.Layout <> ALayout.Value Then 'no change On Error Resume Next TheGrid.Layout = ALayout.Value GridGetLayout = True 'changed End If Exit Do End If bi = Seek(fi) 'next input location Loop Close #fi End Function Function GridSaveLayout (TheFile As String, Which As String, What As String, TheGrid As Control) As Integer ' Logic: Read the entire input file and write a completly new one. ' If the layout is found in the file then replace it. ' If the layout is not found then add it to the end of the file. ' A temporary output file is created then copied to the "real" one. Dim ALayout As TrueGridLayout Dim fi As Integer 'input file Dim fo As Integer 'output file Dim foTemp As String 'temporary name Dim bi As Long 'which byte in input file Dim bo As Long 'which byte in output file Dim LayoutReplacedSw As Integer 'replaced Dim dt As String 'date and time dt = Format$(Now, "ddddd") & "-" & Format$(Now, "ttttt") GridSaveLayout = False 'not saved bi = 1 'beginning of input file bo = 1 'beginning of output file foTemp = TempNamePlease() 'temporary file name fo = FreeFile Open foTemp For Binary As #fo fi = FreeFile Open TheFile For Binary As #fi While bi < LOF(fi) 'process the file Get #fi, bi, ALayout.WhichLen ALayout.Which = String$(ALayout.WhichLen, Chr$(0)) Get #fi, , ALayout.Which Get #fi, , ALayout.TypeLen ALayout.Type = String$(ALayout.TypeLen, Chr$(0)) Get #fi, , ALayout.Type Get #fi, , ALayout.LastUpdatedLen ALayout.LastUpdated = String$(ALayout.LastUpdatedLen, Chr$(0)) Get #fi, , ALayout.LastUpdated Get #fi, , ALayout.ValueLen ALayout.Value = String$(ALayout.ValueLen, Chr$(0)) Get #fi, , ALayout.Value bi = Seek(fi) 'next location If ALayout.Which = Which And ALayout.Type = What Then 'match If Not LayoutReplacedSw Then 'no dups If ALayout.Value <> TheGrid.Layout Then 'no change ALayout.WhichLen = Len(Which) ALayout.Which = Which ALayout.TypeLen = Len(What) ALayout.Type = What ALayout.LastUpdatedLen = Len(dt) ALayout.LastUpdated = dt ALayout.ValueLen = Len(TheGrid.Layout) ALayout.Value = TheGrid.Layout LayoutReplacedSw = True Else 'same, so do nothing Close #fi, #fo Kill foTemp Exit Function End If End If End If Put #fo, bo, ALayout.WhichLen 'write the record Put #fo, , ALayout.Which Put #fo, , ALayout.TypeLen Put #fo, , ALayout.Type Put #fo, , ALayout.LastUpdatedLen Put #fo, , ALayout.LastUpdated Put #fo, , ALayout.ValueLen Put #fo, , ALayout.Value bo = Seek(fo) Wend ' was it replaced? If Not LayoutReplacedSw Then 'append to end ALayout.WhichLen = Len(Which) ALayout.Which = Which ALayout.TypeLen = Len(What) ALayout.Type = What ALayout.LastUpdatedLen = Len(dt) ALayout.LastUpdated = dt ALayout.ValueLen = Len(TheGrid.Layout) ALayout.Value = TheGrid.Layout Put #fo, bo, ALayout.WhichLen 'put the new record Put #fo, , ALayout.Which Put #fo, , ALayout.TypeLen Put #fo, , ALayout.Type Put #fo, , ALayout.LastUpdatedLen Put #fo, , ALayout.LastUpdated Put #fo, , ALayout.ValueLen Put #fo, , ALayout.Value End If Close #fi, #fo On Error Resume Next 'no error stopping FileCopy foTemp, TheFile 'replaces old one as it copies Kill foTemp GridSaveLayout = True 'saved End Function Function TempNamePlease () As String ' Get a temporary file name, concept from MSDN CD7 Dim t As String 'temporary string Dim b As Integer 'buffer size Dim r As Integer 'return value ' b = 144 'suggested buffer size b = 160 'and a little extra, make sure have some spaces t = String$(b, " ") 'load buffer r = GetTempFileName(0, "spa", 0, t) 'API to get the name t = Trim$(t) 'dump extra spaces t = Left$(t, Len(t) - 1) 'dump chr$(0) t = LCase$(t) 'lower case looks better? TempNamePlease = t 'return it End Function